home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / APLIB-F.BAS < prev    next >
BASIC Source File  |  1991-05-17  |  9KB  |  233 lines
  1.  
  2. '     ┌─────────────────────────────────────────────────────────────────┐
  3. '     │                   A P L I B - F . B A S                         │
  4. '     │                                                                 │
  5. '     │ INCLUDE-FOOTER FILE TO ACCOMPANY HB's ALL-PURPOSE LIBRARY UNITS │
  6. '     └─────────────────────────────────────────────────────────────────┘
  7.  
  8.  PRINT "ERROR!! Execution has reached the footer file APLIB-F.BAS !!"
  9.  BEEP: BEEP: BEEP: DELAY 3
  10.  END 1
  11.  
  12. Oops:
  13. '                     ERROR HANDLING SUBROUTINE
  14. '                      =======================
  15.  
  16.  DO: LOOP UNTIL INKEY$ = "" '                    first purge the keyboard buffer
  17.  SELECT CASE ERR
  18.  
  19.    CASE 52, 53, 54, 55, 58, 61, 64, 67, 70, 71, 72, 73, 74, 75, 76
  20. '                                 if a dos error, it lets you know but goes on
  21.      PLAY "ML O0 C16 D64"
  22.      FileError = %True
  23.      L00 = CSRLIN: C00 = POS
  24.      CALL SCREENPUSH
  25.      IF ErrorMessage$ <> "" THEN
  26.        LOCATE 23,1: COLOR %Red, %Wht: CALL ClearLine
  27.        PRINT "      => ";ErrorMessage$
  28.      END IF
  29.      BoxColor = %Wht + %Background * %Red
  30.      CALL QBox (%Center, 15, 1,_
  31.          "OOPS! DOS UNABLE TO FIND OR USE A FILE. ERROR" + STR$(ERR) +_
  32.                                                  " @ " + STR$ (ERADR) , 0)
  33.      DELAY 1
  34.      CALL PressAKey
  35.      CALL SCREENPOP
  36.      LOCATE L00, C00
  37.      RESUME NEXT
  38.  
  39.    CASE 24, 25, 27, 57
  40. '                           if error is the printer, beeps til you press a key
  41.  
  42.      DATA "P R I N T E R   (or i/o)  E R R O R"
  43.      DATA "====="
  44.      DATA "Please check the printer. Probably it is either"
  45.      DATA "off, not on-line, unplugged or out of paper."
  46.      DATA "Kindly FIX IT ... then PRESS SPACEBAR to go ahead"
  47.      DATA "with printing ... OR press [ESC] TO EXIT to DOS."
  48.      DATA END
  49.  
  50.      L00 = CSRLIN: C00 = POS
  51.      CALL SCREENPUSH
  52.      IF ErrorMessage$ <> "" THEN
  53.        LOCATE 23,1: COLOR %Red, %Wht: CALL ClearLine
  54.        PRINT "      => ";ErrorMessage$
  55.      END IF
  56.      RESTORE Oops
  57.      CALL BOXMESSAGE (%Center, %Center, 4)
  58.      DO
  59.         PLAY "O3 C64 P16 O4 C64 O3 P16 G-64"
  60.         FOR N = 1 TO 30
  61.           DELAY .1
  62.           IF INSTAT THEN EXIT FOR
  63.         NEXT
  64.      LOOP UNTIL INSTAT
  65.      CALL SCREENPOP
  66.      LOCATE L00, C00
  67.      IF INKEY$ = CHR$(27) THEN
  68.        CALL CloseFiles
  69.        LOCATE 23, 1
  70.        END 1
  71.      ELSEIF  ErrorMessage$ = "fake error generated from HBDEMO menus" THEN
  72.        JustDemonstratingOops = %False
  73.        RESUME NEXT
  74.      ELSE
  75.        RESUME
  76.      END IF
  77.    CASE ELSE '                                  for all other errors we notify
  78.      PLAY "ML O0 C16 D64" '                     user and quit ... UNLESS you set
  79.      IF ErrorMessage$ <> "" THEN '                      it up to use ERFIND and
  80.        LOCATE 21,1: COLOR %Red, %Wht: CALL ClearLine '  QEdit to put you back in
  81.        PRINT "      => ";ErrorMessage$ '                your code at the error !
  82.      END IF
  83.      LOCATE 22,1: COLOR %Red, %Wht: CALL ClearLine
  84.      PRINT " OOPS! UNABLE TO CONTINUE. ERROR";ERR;" AT ADDRESS ";ERADR;"     "
  85.      COLOR %Red, %Gry
  86.      BXScreenSaved = %False
  87.      CALL CloseFiles
  88.      COLOR %Grn, %Blk
  89.      LOCATE 25,1: CALL ClearLine
  90.      LOCATE 24,1: CALL ClearLine
  91.      IF GoToSourceFile THEN '                 this triggers the ERFIND sequence
  92.        IF LEN (RDisk$) < 2  THEN '                              (see APLIB.DOC)
  93.          CALL SCREENPUSH
  94.          RESTORE DebugMsg
  95.          DebugMsg:
  96.          DATA "The GoToSourceFile flag was set in this program; but
  97.          DATA "to use the new AUTOMATIC DEBUGGING gimmick you also need"
  98.          DATA "to designate a drive letter as RDisk$ from your main"
  99.          DATA "program (D or E or whatever) to tell ApLib where to"
  100.          DATA "put temporary batch files. Normally this would be a
  101.          DATA "RAM-Disk. Also you need to have the shareware editor"
  102.          DATA "QEdit on your hard disk or somewhere DOS can use it."
  103.          DATA END
  104.          CALL BOXMESSAGE (0,0,0)
  105.          CALL PressAKey
  106.          CALL SCREENPOP
  107.          LOCATE 24,1
  108.          GoToSourceFile = %False
  109.        ELSE
  110.          IF NOT ColorDisplay THEN FlashBox = %True
  111.          CALL SCREENPUSH
  112.          CALL QBox (%Center, %Center, 1, "SEARCH FOR ERROR IN SOURCE FILE ? ", 8)
  113.          Yes = GETYESORNO
  114.          CALL SCREENPOP
  115.          IF Yes THEN
  116.            CLS
  117.            IF DIR$ (RDisk$ + "GETERR.&BA") <> "" THEN KILL RDisk$ + "GETERR.&BA"
  118.            IF DIR$ (RDisk$ + "GETERR.BAT") <> "" THEN
  119.              NAME RDisk$ + "GETERR.BAT" AS RDisk$ + "GETERR.&BA"
  120.            END IF
  121.            OutBat = FREEFILE
  122.            OPEN RDisk$ + "GETERR.BAT" FOR OUTPUT AS #OutBat '  create output bat file
  123.            A$ = "@echo off"
  124.            PRINT #OutBat, A$
  125.            IF ColorDisplay THEN
  126.              A$ = "Color 35"
  127.              PRINT #OutBat, A$
  128.            END IF
  129.            A$ = "cd " + SourceDir$
  130.            PRINT #OutBat, A$
  131.            A$ = "error " + STR$ (ERR)
  132.            PRINT #OutBat, A$
  133.            A$ = "pbc /ce /re" + LTRIM$ (STR$ (ERADR)) + " " + SourceFile$
  134.            PRINT #OutBat, A$
  135.            A$ = "ERFIND " + SourceFile$
  136.            PRINT #OutBat, A$
  137.            CLOSE #OutBat
  138.            CALL BufferStuffer (RDisk$ + "GETERR" + CHR$(13)) '   and run it
  139.          ELSE
  140.            LOCATE 24, 1
  141.          END IF
  142.        END IF
  143.      END IF
  144.      END 1 '                                             this places the DOS
  145.  END SELECT '                                            prompt at 25,1 for you
  146.  RESUME '                                                without messing up
  147. '                                                        the display otherwise.
  148. '
  149. '                      ┌────────────────────────────────────┐
  150. '                      │      E R R O R  H A N D L E R      │
  151. '                      │   H A S  E X I T E D  T O  D O S   │
  152. '                      │    Note: ERRORLEVEL is set to 1.   │
  153. '                      └────────────────────────────────────┘
  154.  
  155.  
  156. SetBeeps:
  157.   LookitBeep$ = "MN T100 O5 C64 P64 O4 E64"
  158.   ArribaBeep$ = "MN T70 O2 A32 > E4"
  159. ''  ArribaBeep$ = "MN T70 O2 A32 P32 A32 A32 > E4"
  160.   TaskBeep$ = "MB T100 O3 C16 E32 F32 G16 E16 C16"
  161.   PressAKeyBeep$ = "T120 MS O4 G64 P16 G64 MN"
  162.   OopsBeep$ = "MN T120 O1 A64"
  163.   TinyBeep$ = "MS T240 O4 B-64"
  164. '                                      From HB PowerBasic Beep Tester, 02-26-91:
  165.   Tune6Beep$ = "O3 T180 MS E8 E4 E4 < B8 > C#4 < A4 P4 > A8"
  166.  
  167.  RETURN
  168.  
  169. MZap:
  170.  NextScrn2Pop = MainMenuScreen '                     handles clearing a pulldown
  171.  CALL SCREENPOP '                                    menu when Esc or right button
  172.  DEF SEG = VideoSeg&'                                is pressed ...
  173.  TopAtt = PEEK (1)
  174.  FOR I = 161 TO 320 STEP 2: POKE I, TopAtt: NEXT '   erases the cursor from the
  175.  DEF SEG '                                           TopBar menu (sets its color
  176.  RETURN '                                            the same as the rest)
  177.  
  178. ClickOrStrike:
  179.  DO: LOOP UNTIL INKEY$ <> "" OR MouseClicked
  180.  RETURN
  181.  
  182. SetColors:
  183.  
  184.  
  185.  IF COMMAND$ <> "" THEN
  186.    ScrColor = ReadParamFor ("ScrC") '              ReadParamFor looks
  187.    MenuColor = ReadParamFor ("MnuC") '            for a command line switch
  188.    BarColor = ReadParamFor ("BarC") '            like "BoxC=3F", for example,
  189.    WinColor = ReadParamFor ("WinC") '            which sets the color of a
  190.    FldColor = ReadParamFor ("FldC") '            box to &H3F (like COLOR 15,3)
  191.    BoxColor = ReadParamFor ("BoxC")  '           that is, white letters on cyan
  192.  ELSE '                                          background ...
  193.    MenuColor = 0:  BarColor = 0:   WinColor = 0
  194.    FldColor = 0:   BoxColor = 0:   ScrColor = 0
  195.  END IF
  196.  
  197. '                                 then if colors are not yet set (= 0) we give
  198. '                                   them a default value here:
  199.  IF ColorDisplay THEN
  200.    IF MenuColor = 0 THEN MenuColor = %ColorMenu
  201.    IF BarColor = 0 THEN BarColor =   %ColorBar
  202.    IF WinColor = 0 THEN WinColor =   %ColorWin
  203.    IF FldColor = 0 THEN FldColor =   %ColorFld
  204.    IF BoxColor = 0 THEN BoxColor =   %ColorBox
  205.    IF ScrColor = 0 THEN ScrColor =   %ColorScr
  206.  ELSE
  207.    IF MenuColor = 0 THEN MenuColor = %MonoMenu
  208.    IF BarColor = 0 THEN BarColor =   %MonoBar
  209.    IF WinColor = 0 THEN WinColor =   %MonoWin
  210.    IF FldColor = 0 THEN FldColor =   %MonoFld
  211.    IF BoxColor = 0 THEN BoxColor =   %MonoBox
  212.    IF ScrColor = 0 THEN ScrColor =   %MonoScr
  213.  END IF
  214.  RETURN
  215.  
  216. WipeLn:
  217.  ClP0 = POS
  218.  PRINT SPACE$(81-POS);
  219.  LOCATE CSRLIN, ClP0
  220.  RETURN
  221.  
  222. SUB Marker (Messg$) '                                  this is for debugging ...
  223.  LOCAL L,C
  224.  L = CSRLIN: C = POS
  225.  CALL SCREENPUSH
  226.  CALL QBox (%Center, %Center, 1, "Marker Message "+Messg$, 0)
  227.  DO: LOOP UNTIL INKEY$ <> ""
  228.  CALL SCREENPOP
  229.  LOCATE L,C
  230. END SUB
  231.  
  232.  
  233.